home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 32
/
Aminet 32 (1999)(Schatztruhe)[!][Aug 1999].iso
/
Aminet
/
misc
/
emu
/
TasRead.lha
/
ppc680x0
/
TasRead
/
TasRead.bas
< prev
next >
Wrap
BASIC Source File
|
1999-04-26
|
8KB
|
286 lines
REM ------------------------------
REM TASREAD Tasword text formatter
REM Cut down from DOC2RTF: SNG/MJS
REM ------------------------------
REM Originally for ZX82 files from XFS or SP_HANDLER
REM Extended to read PLUS3DOS files from ZIPs or XFS
' Works from Command Line or Workbench - expects ASL
' (WB2+ or PD versions) for Workbench file selector,
' but works without that, from the Amigados 1.3 CLI.
'
' It should really trap the ASL library open failure
' and use simple INPUTs if running <= Workbench 1.3.
'
' Workbench view is not yet properly font adaptive -
' text above 8 pitch overlaps progress indicator and
' may be too big for the window if average character
' width is more than eight pixels. Modified to use a
' fixed helvetica 15 font - would probably be better
' if it's font-adaptive, or sizes the window to fit.
'
REM $INCLUDE asl.bh ' HiSoft's ASL Requester support
REM $INCLUDE graphics.bh
REM $INCLUDE diskfont.bh
verstag$="$VER: TasRead 1.02 (26/4/99)"
CommandLine%=LEN(COMMAND$)
IF CommandLine%=0
LIBRARY OPEN "diskfont.library"
LIBRARY OPEN "graphics.library"
LIBRARY OPEN "asl.library"
DIM TextAttr%(4)
DIM frintags&(20) ' ASL Tag arrays
DIM frouttags&(20)
OutDrawer$="RAM:" ' Path defaults
InDrawer$="SP0:"
InName$=""
margin%=0
extraR%=(PEEKW(SYSTAB+2)-200)\2 ' Add to file requester
extra%=extraR%
IF extraR%>18 THEN extra%=18 ' Add to window is limited
END IF
REPEAT outer_loop
IF CommandLine%
' we have a command line - try to parse it
InFile$=COMMAND$
IF INSTR(InFile$,"?") THEN
PRINT "Fixed to variable length file converter ";ver$
PRINT "Example: TasREAD InFile OutFile"
SYSTEM
END IF
gap%=INSTR(InFile$," ")
gap1%=gap%
REPEAT closeUp
IF gap%=0 THEN EXIT closeUp
IF gap%>=LEN(InFile$) THEN gap%=0 : EXIT closeUp
IF MID$(Infile$,gap%+1,1)<"!"
gap%=gap%+1
ELSE
EXIT closeUp
END IF
END REPEAT closeUp
IF gap%=0
OutFile$=InFile$+".ExTas"
ELSE
IF UCASE$(MID$(InFile$,gap%+1,2))="TO" AND MID$(InFile$,gap%+3,1)<"!"
OutFile$=MID$(InFile$,gap%+3,1024)
ELSE
OutFile$=MID$(InFile$,gap%+1,1024)
END IF
REPEAT tidy
IF LEFT$(OutFile$,1)<"!"
OutFile$=MID$(OutFile$,2,1024)
ELSE
EXIT tidy ' Controls and spaces stripped from start
END IF
END REPEAT tidy
InFile$=LEFT$(InFile$,gap1%-1) ' Keep up to first space
END IF
PRINT "Converting from ";Infile$;" TO ";Outfile$
ELSE
' Use Workbench screen (assume 640x200) ' SCREEN 1,640,200,LOG2(2),4
WINDOW 1," TasRead by Simon N Goodwin, version " + MID$(verstag$,14,5), _
(60,2+extra%)-(560,198+extra%),2+4+16+256
WIDTH 72 ' Ensure text leaves room for a progress bar on the right
REM Use a groovy Compugraphic fo(u)nt
InitTextAttr TextAttr%(),"helvetica.font",15,0,0
font& = OpenDiskFont (VARPTR(TextAttr%(0)))
IF font&=0
PRINT "Oops - Helvetica 15 point font not found!"
PRINT "Tap something to use your system default."
MouseWait
ELSE
SetFont WINDOW (8), font&
COLOR 1,0,1
END IF
CLS
PRINT
PRINT " This utility converts files in TasWord or SamScratch fixed-length"
PRINT " line format into Amiga OS, Unix and Qdos files of lines delimited"
PRINT " by Line Feed characters [CHR$(10)] so they can be read or edited."
PRINT
PRINT " Written in Amiga HiSoft BASIC 2 by Simon N Goodwin 2/1997-4/1999."
PRINT
LINE (463,13)-(526,128),2,b
LINE (464,14)-(527,129),1,b
' No command line so use the ASL file requester (expects WB2 and up)
TAGLIST VARPTR(frintags&(0)),ASLFR_TitleText&,"Input file selector", _
ASLFR_InitialFile&,InName$, _
ASLFR_InitialDrawer&, InDrawer$, _
ASLFR_InitialHeight&, 150+extraR%, _
ASLFR_InitialLeftEdge&, 338, _
ASLFR_InitialTopEdge&, 50+extraR%, _
TAG_DONE&
fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frintags&(0)))
IF fr& THEN
IF AslRequest&(fr&,0) THEN
' A file name was entered; build the full path
InDrawer$=PEEK$(PEEKL(fr&+fr_Drawer%)): filename$=InDrawer$
IF RIGHT$(InDrawer$,1)<>":" THEN filename$=filename$+"/"
InName$=PEEK$(PEEKL(fr&+fr_File%))
filename$=filename$+InName$
ELSE
filename$=""
END IF
FreeASlRequest fr&
InFile$=filename$
COLOR 1,3,1
PRINT PTAB(margin%);"Reading from ";InFile$
ELSE
REM No ASL - this currently fails at the OPEN LIBRARY
INPUT " Enter TasWord filename >";InFile$
END IF
IF InFile$="" THEN EXIT outer_loop
IF UCASE$(RIGHT$(InName$,4))=".TAS"
OutFile$=LEFT$(InName$,LEN(InName$)-4)+".ExTas"
ELSE
OutFile$=InName$+".ExTas"
END IF
TAGLIST VARPTR(frouttags&(0)), _
ASLFR_TitleText&,"Output file selector", _
ASLFR_InitialFile&, OutFile$, _
ASLFR_InitialDrawer&, OutDrawer$, _
ASLFR_InitialHeight&, 150+extraR%, _
ASLFR_InitialLeftEdge&, 336, _
ASLFR_InitialTopEdge&, 50+extraR%, _
TAG_DONE&
fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frouttags&(0)))
IF fr& THEN
IF AslRequest&(fr&,0) THEN
' A file name was entered; build the full path
filename$=PEEK$(PEEKL(fr&+fr_Drawer%))
IF RIGHT$(filename$,1)<>":" THEN filename$=filename$+"/"
filename$=filename$+PEEK$(PEEKL(fr&+fr_File%))
ELSE
filename$=""
END IF
FreeASlRequest fr&
OutFile$=filename$
PRINT PTAB(margin%);"Writing to ";OutFile$
ELSE
INPUT " Enter destination filename >";OutFile$
END IF
IF OutFile$="" THEN EXIT outer_loop
PRINT PTAB(margin%);"Converting...";
END IF ' Interactive
OPEN InFile$ FOR INPUT AS #4
' Attempt to work out line width from file size
' This is not tested yet. Also character arrays
' should be regonised and specially treated.
a$=INPUT$(12,#4)
IF LEFT$(a$,8)="PLUS3DOS"
a$=INPUT$(128-12,#4) ' Strip rest of 3 header
Prefix%=64
ELSE
IF LEFT$(a$,4)="ZX82"
Prefix%=12
ELSE
PRINT "Sorry, ";Infile$;" is not a ZX82 format file."
MouseWait
EXIT outer_loop
END IF
END IF
length%=64
IF Prefix%=(LOF(4) MOD 85) THEN length%=85 ' Wide?
' IF Prefix%=(LOF(4) MOD 32) THEN length%=32 ' Narrow??
OPEN Outfile$ FOR OUTPUT AS #5
REPEAT paraLoop
IF EOF(4) THEN EXIT paraLoop
IF LOC(4)+length%>LOF(4) THEN length%=LOF(4)-LOC(4)
a$=INPUT$(length%,#4)
IF a$=SPACE$(length%)
a$=""
ELSE
here%=length%
REPEAT trim
IF MID$(a$,here%,1)=" "
here%=here%-1
ELSE
a$=LEFT$(a$,here%)
EXIT trim
END IF
END REPEAT trim
END IF
PRINT #5,a$
IF CommandLine%=0
IF LOC(4)=LOF(4) THEN
LINE (474,20)-(514,120),1,bf
ELSE
LINE (474,20)-(514,20+LOC(4)*100\LOF(4)),1,bf
END IF
END IF
END REPEAT paraLoop
CLOSE #5
CLOSE #4
IF CommandLine% THEN EXIT outer_loop
PRINT "Done - tap to continue."; : MouseWait
END REPEAT outer_loop
SYSTEM ' Formerly STOP but no need for keypress
' Amiga specific user-interface stuff follows
SUB InitTextAttr(T%(1),FontName$,BYVAL Height,BYVAL style,BYVAL flags)
POKEL VARPTR(T%(0))+ta_Name%,SADD(FontName$+CHR$(0))
T%(ta_YSize%\2)=Height
POKEB VARPTR(T%(0))+ta_Style%,style
POKEB VARPTR(T%(0))+ta_Flags%,flags
END SUB
SUB MouseWait
LOCAL key$ ' No need to share here
REPEAT debounce
IF MOUSE(0)=0 THEN EXIT debounce
END REPEAT debounce
REPEAT poll
SLEEP : key$=INKEY$
IF MOUSE(0) THEN key$=CHR$(0)
IF LEN(key$) THEN EXIT poll
END REPEAT poll
END SUB ' MouseWait